home *** CD-ROM | disk | FTP | other *** search
/ Kit PC World De Ampliacion De Windows 95 / Kit PC World de ampliacion de Windows 95.iso / internet / sweeper / samples / olecon~1 / wizards / transfrm.frm < prev    next >
Text File  |  1995-12-04  |  14KB  |  348 lines
  1. VERSION 4.00
  2. Begin VB.Form frmTransform 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "Generating OLE Control"
  5.    ClientHeight    =   1725
  6.    ClientLeft      =   4110
  7.    ClientTop       =   5520
  8.    ClientWidth     =   6090
  9.    ControlBox      =   0   'False
  10.    Height          =   2145
  11.    Left            =   4050
  12.    LinkTopic       =   "Form1"
  13.    MaxButton       =   0   'False
  14.    MinButton       =   0   'False
  15.    ScaleHeight     =   1725
  16.    ScaleWidth      =   6090
  17.    ShowInTaskbar   =   0   'False
  18.    Top             =   5160
  19.    Width           =   6210
  20.    Begin ComctlLib.ProgressBar ProgressBar1 
  21.       Height          =   255
  22.       Left            =   600
  23.       TabIndex        =   1
  24.       Top             =   840
  25.       Width           =   4815
  26.       _Version        =   65536
  27.       _ExtentX        =   8493
  28.       _ExtentY        =   450
  29.       _StockProps     =   192
  30.       Appearance      =   1
  31.    End
  32.    Begin VB.Label lblmessage 
  33.       Alignment       =   2  'Center
  34.       Caption         =   "Label1"
  35.       Height          =   495
  36.       Left            =   600
  37.       TabIndex        =   0
  38.       Top             =   120
  39.       Width           =   4695
  40.    End
  41. End
  42. Attribute VB_Name = "frmTransform"
  43. Attribute VB_Creatable = False
  44. Attribute VB_Exposed = False
  45. Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long _
  46. )
  47.  
  48. Dim m_szGuidLibid As String
  49. Dim m_szGuidPrimaryDispatch As String
  50. Dim m_szGuidEventInterface As String
  51. Dim m_szGuidCoClass As String
  52. Dim m_szGuidPropPage As String
  53.  
  54.  
  55.  
  56. Private Sub Form_Load()
  57.  
  58.     Show
  59.  
  60.     On Error GoTo Blech
  61.     
  62.     If Dir(szSourceDir) = "" Then
  63. Blech:
  64.         szSourceDir = InputBox("Unable to find Template files in '" + szFinalDir + "'. Please Enter an alternate location.", "Control Wizard")
  65.     End If
  66.     On Error GoTo 0
  67.     If g_fLoser = True Then szControlName = Left(szControlName, 8)
  68.  
  69.     lblmessage.Caption = "Creating Directories"
  70.     Refresh
  71.     m_CreateDirs
  72.     ProgressBar1.Value = 25
  73.     lblmessage.Caption = "Generating GUIDs"
  74.     Refresh
  75.     m_MakeGUIDs
  76.     ProgressBar1.Value = 50
  77.     lblmessage.Caption = "Copying over control files"
  78.     Refresh
  79.     m_CopyFiles
  80.     ProgressBar1.Value = 75
  81.     lblmessage.Caption = "Setting up control"
  82.     Refresh
  83.     m_ReplaceNames
  84.     ProgressBar1.Value = 100
  85.     Refresh
  86. End Sub
  87.  
  88. Sub m_MakeGUIDs()
  89.  
  90.     m_szGuidLibid = GenerateUUID
  91.     m_szGuidPrimaryDispatch = GenerateUUID
  92.     m_szGuidEventInterface = GenerateUUID
  93.     m_szGuidCoClass = GenerateUUID
  94.     m_szGuidPropPage = GenerateUUID
  95.     
  96.  
  97. End Sub
  98.  
  99. Private Sub m_CreateDirs()
  100.     On Error GoTo die
  101.     MkDir szFinalDir
  102.  
  103.     
  104.     MkDir szFinalDir + "\Release"
  105.     MkDir szFinalDir + "\Debug"
  106.     If g_fSatellite = True Then MkDir szFinalDir + "\French"
  107.     Exit Sub
  108.     
  109. die:
  110.     MsgBox "Couldn't Create directories"
  111.     End
  112. End Sub
  113.  
  114. Private Sub m_CopyFiles()
  115.  
  116.     Dim s As String
  117.     
  118.     If g_fLoser = True Then
  119.         s = Left(szControlName, 5)
  120.     Else
  121.         s = szControlName
  122.     End If
  123.     FileCopy szSourceDir + "\dispids.h", szFinalDir + "\Dispids.h"
  124.     FileCopy szSourceDir + "\guids.cpp", szFinalDir + "\Guids.Cpp"
  125.     FileCopy szSourceDir + "\guids.h", szFinalDir + "\Guids.H"
  126.     FileCopy szSourceDir + "\LocalObj.H", szFinalDir + "\LocalObj.H"
  127.     FileCopy szSourceDir + "\Makefile", szFinalDir + "\Makefile"
  128.     FileCopy szSourceDir + "\Resource.H", szFinalDir + "\Resource.H"
  129.     FileCopy szSourceDir + "\Template.Bmp", szFinalDir + "\" + s + "Ctl.Bmp"
  130.     FileCopy szSourceDir + "\Template.Cpp", szFinalDir + "\" + szControlName + ".Cpp"
  131.     FileCopy szSourceDir + "\Template.Def", szFinalDir + "\" + szControlName + ".Def"
  132.     FileCopy szSourceDir + "\Template.ODL", szFinalDir + "\" + szControlName + ".ODL"
  133.     If g_fSatellite = False Then
  134.         FileCopy szSourceDir + "\Template.RC", szFinalDir + "\" + szControlName + ".RC"
  135.     Else
  136.         FileCopy szSourceDir + "\TemplSat.RC", szFinalDir + "\" + szControlName + ".RC"
  137.     End If
  138.     If g_szSubClassName = "" Then
  139.         FileCopy szSourceDir + "\TemplCtl.Cpp", szFinalDir + "\" + s + "Ctl.Cpp"
  140.     Else
  141.         FileCopy szSourceDir + "\SubClCtl.Cpp", szFinalDir + "\" + s + "Ctl.Cpp"
  142.     End If
  143.     FileCopy szSourceDir + "\TemplCtl.H", szFinalDir + "\" + s + "Ctl.H"
  144.     FileCopy szSourceDir + "\templPPG.Cpp", szFinalDir + "\" + s + "PPG.Cpp"
  145.     FileCopy szSourceDir + "\templppg.h", szFinalDir + "\" + s + "PPG.H"
  146.     FileCopy szSourceDir + "\Debug\Make.Bat", szFinalDir + "\Debug\Make.Bat"
  147.     FileCopy szSourceDir + "\Release\Make.Bat", szFinalDir + "\Release\Make.Bat"
  148.     
  149.     If g_fSatellite = True Then
  150.         FileCopy szSourceDir + "\French\make.bat", szFinalDir + "\French\make.bat"
  151.         FileCopy szSourceDir + "\French\Makefile", szFinalDir + "\French\Makefile"
  152.         FileCopy szSourceDir + "\French\Template.odl", szFinalDir + "\French\" + s + "Sat.Odl"
  153.         FileCopy szSourceDir + "\French\TemplSat.Cpp", szFinalDir + "\French\" + s + "Sat.Cpp"
  154.         FileCopy szSourceDir + "\French\TemplSat.Def", szFinalDir + "\French\" + s + "Sat.Def"
  155.         FileCopy szSourceDir + "\French\TemplSat.Rc", szFinalDir + "\French\" + s + "Sat.Rc"
  156.     End If
  157.  
  158. End Sub
  159.  
  160. Private Sub m_ReplaceNames()
  161.     
  162.     Dim s As String
  163.     If g_fLoser = True Then
  164.         s = Left(szControlName, 5)
  165.     Else
  166.         s = szControlName
  167.     End If
  168.    
  169.     ReplaceFile szFinalDir + "\Dispids.H", "<<DEFCONTROLNAME>>", szControlName
  170.     ReplaceFile szFinalDir + "\Dispids.H", "<<DEFCONTROLNAMECAPS>>", UCase(szControlName)
  171.     ReplaceFile szFinalDir + "\Dispids.H", "<<DEFCONTROLTRUNCNAME>>", s
  172.     
  173.     ReplaceFile szFinalDir + "\guids.cpp", "<<DEFCONTROLNAME>>", szControlName
  174.     ReplaceFile szFinalDir + "\guids.cpp", "<<DEFSERVERNAME>>", szControlName
  175.     ReplaceFile szFinalDir + "\guids.cpp", "<<DEFCONTROLNAMECAPS>>", UCase(szControlName)
  176.     ReplaceFile szFinalDir + "\guids.cpp", "<<DEFCONTROLTRUNCNAME>>", s
  177.     
  178.     ReplaceFile szFinalDir + "\guids.h", "<<DEFCONTROLNAME>>", szControlName
  179.     ReplaceFile szFinalDir + "\guids.H", "<<DEFCONTROLNAMECAPS>>", UCase(szControlName)
  180.     ReplaceFile szFinalDir + "\guids.H", "<<DEFCONTROLTRUNCNAME>>", s
  181.     
  182.     ReplaceFile szFinalDir + "\localobj.H", "<<DEFCONTROLNAME>>", szControlName
  183.     ReplaceFile szFinalDir + "\localobj.H", "<<DEFCONTROLNAMECAPS>>", UCase(szControlName)
  184.     ReplaceFile szFinalDir + "\localobj.H", "<<DEFCONTROLTRUNCNAME>>", s
  185.     
  186.     ReplaceFile szFinalDir + "\makefile", "<<DEFCONTROLNAME>>", szControlName
  187.     ReplaceFile szFinalDir + "\makefile", "<<DEFCONTROLNAMECAPS>>", UCase(szControlName)
  188.     ReplaceFile szFinalDir + "\makefile", "<<DEFCONTROLTRUNCNAME>>", s
  189.     
  190.     ReplaceFile szFinalDir + "\resource.h", "<<DEFCONTROLNAME>>", szControlName
  191.     ReplaceFile szFinalDir + "\resource.h", "<<DEFCONTROLNAMECAPS>>", UCase(szControlName)
  192.     ReplaceFile szFinalDir + "\resource.H", "<<DEFCONTROLTRUNCNAME>>", s
  193.     
  194.     ReplaceFile szFinalDir + "\" + szControlName + ".cpp", "<<DEFCONTROLNAME>>", szControlName
  195.     ReplaceFile szFinalDir + "\" + szControlName + ".cpp", "<<DEFSERVERNAME>>", szControlName
  196.     ReplaceFile szFinalDir + "\" + szControlName + ".cpp", "<<DEFCONTROLNAMECAPS>>", UCase(szControlName)
  197.     ReplaceFile szFinalDir + "\" + szControlName + ".cpp", "<<DEFCONTROLTRUNCNAME>>", s
  198.     ReplaceFile szFinalDir + "\" + szControlName + ".cpp", "<<USESSATELLITELOCALIZATION>>", UCase(Str$(g_fSatellite))
  199.     
  200.     ReplaceFile szFinalDir + "\" + szControlName + ".def", "<<DEFCONTROLNAME>>", szControlName
  201.     ReplaceFile szFinalDir + "\" + szControlName + ".def", "<<DEFCONTROLNAMECAPS>>", UCase(szControlName)
  202.     ReplaceFile szFinalDir + "\" + szControlName + ".def", "<<DEFCONTROLTRUNCNAME>>", s
  203.  
  204.     ReplaceFile szFinalDir + "\" + szControlName + ".odl", "<<DEFCONTROLNAME>>", szControlName
  205.     ReplaceFile szFinalDir + "\" + szControlName + ".odl", "<<DEFCONTROLNAMECAPS>>", UCase(szControlName)
  206.     ReplaceFile szFinalDir + "\" + szControlName + ".odl", "<<DEFCONTROLTRUNCNAME>>", s
  207.     ReplaceFile szFinalDir + "\" + szControlName + ".odl", "<<GUID_LIBID>>", m_szGuidLibid
  208.     ReplaceFile szFinalDir + "\" + szControlName + ".odl", "<<GUID_PRIMARYDISPATCH>>", m_szGuidPrimaryDispatch
  209.     ReplaceFile szFinalDir + "\" + szControlName + ".odl", "<<GUID_EVENTINTERFACE>>", m_szGuidEventInterface
  210.     ReplaceFile szFinalDir + "\" + szControlName + ".odl", "<<GUID_COCLASS>>", m_szGuidCoClass
  211.  
  212.     ReplaceFile szFinalDir + "\" + szControlName + ".rc", "<<DEFCONTROLNAME>>", szControlName
  213.     ReplaceFile szFinalDir + "\" + szControlName + ".rc", "<<DEFCONTROLNAMECAPS>>", UCase(szControlName)
  214.     ReplaceFile szFinalDir + "\" + szControlName + ".rc", "<<DEFCONTROLTRUNCNAME>>", s
  215.  
  216.     ReplaceFile szFinalDir + "\" + s + "Ctl.Cpp", "<<DEFCONTROLNAME>>", szControlName
  217.     ReplaceFile szFinalDir + "\" + s + "Ctl.Cpp", "<<DEFCONTROLNAMECAPS>>", UCase(szControlName)
  218.     ReplaceFile szFinalDir + "\" + s + "Ctl.Cpp", "<<DEFCONTROLTRUNCNAME>>", s
  219.     If g_szSubClassName <> "" Then ReplaceFile szFinalDir + "\" + s + "Ctl.Cpp", "<<SUBCLASSWINDOWCLASS>>", g_szSubClassName
  220.  
  221.     ReplaceFile szFinalDir + "\" + s + "Ctl.h", "<<DEFCONTROLNAME>>", szControlName
  222.     ReplaceFile szFinalDir + "\" + s + "Ctl.h", "<<DEFCONTROLNAMECAPS>>", UCase(szControlName)
  223.     ReplaceFile szFinalDir + "\" + s + "Ctl.h", "<<DEFCONTROLTRUNCNAME>>", s
  224.  
  225.     ReplaceFile szFinalDir + "\" + s + "PPG.Cpp", "<<DEFCONTROLNAME>>", szControlName
  226.     ReplaceFile szFinalDir + "\" + s + "PPG.Cpp", "<<DEFCONTROLNAMECAPS>>", UCase(szControlName)
  227.     ReplaceFile szFinalDir + "\" + s + "PPG.Cpp", "<<DEFCONTROLTRUNCNAME>>", s
  228.  
  229.     ReplaceFile szFinalDir + "\" + s + "PPG.h", "<<DEFCONTROLNAME>>", szControlName
  230.     ReplaceFile szFinalDir + "\" + s + "PPG.h", "<<DEFCONTROLNAMECAPS>>", UCase(szControlName)
  231.     ReplaceFile szFinalDir + "\" + s + "PPG.h", "<<DEFCONTROLTRUNCNAME>>", s
  232.  
  233.     ReplaceFile szFinalDir + "\" + "guids.H", "<<PPGGUID>>", GetPPGGuidString
  234.  
  235.     If g_fSatellite = True Then
  236.  
  237.         ReplaceFile szFinalDir + "\French\Makefile", "<<DEFCONTROLNAME>>", szControlName
  238.         ReplaceFile szFinalDir + "\French\" + s + "Sat.Def", "<<DEFCONTROLNAME>>", szControlName
  239.         ReplaceFile szFinalDir + "\French\" + s + "Sat.Rc", "<<DEFCONTROLNAME>>", szControlName
  240.         ReplaceFile szFinalDir + "\French\" + s + "Sat.Rc", "<<DEFCONTROLNAMECAPS>>", UCase(szControlName)
  241.         ReplaceFile szFinalDir + "\French\" + s + "Sat.ODL", "<<DEFCONTROLNAME>>", szControlName
  242.         ReplaceFile szFinalDir + "\French\" + s + "Sat.ODL", "<<GUID_LIBID>>", m_szGuidLibid
  243.         ReplaceFile szFinalDir + "\French\" + s + "Sat.ODL", "<<GUID_PRIMARYDISPATCH>>", m_szGuidPrimaryDispatch
  244.         ReplaceFile szFinalDir + "\French\" + s + "Sat.ODL", "<<GUID_EVENTINTERFACE>>", m_szGuidEventInterface
  245.         ReplaceFile szFinalDir + "\French\" + s + "Sat.ODL", "<<GUID_COCLASS>>", m_szGuidCoClass
  246.     
  247.     End If
  248.  
  249. End Sub
  250.  
  251.  
  252.  
  253.  
  254. Function ReplaceData(ByVal sData As String, ByVal sInToken As String, ByVal sOutToken As String) As String
  255.     If Len(sData) = 0 Then Exit Function
  256.     Dim iLast As Integer
  257.     Dim sPart As String
  258.     Dim sTemp As String
  259.     
  260.     sTemp = sData
  261.     
  262.     'Now do double quotes
  263.     iLast = InStr(sData, sInToken)
  264.     While iLast
  265.         sPart = sPart & Left$(sData, iLast - 1) & sOutToken
  266.         sData = Right$(sData, Len(sData) - iLast - Len(sInToken) + 1)
  267.         iLast = InStr(sData, sInToken)
  268.     Wend
  269.     sData = sPart & sData
  270.     'Debug.Print sData
  271.     
  272.     ReplaceData = sData
  273. End Function
  274.     
  275. Function ReplaceFile(ByVal sInName As String, ByVal sInToken As String, ByVal sOutToken As String) As Boolean
  276.     Dim iFNum As Integer
  277.     Dim iFOut As Integer
  278.     Dim sHead As String
  279.     Dim sTemp As String
  280.     
  281.     On Error GoTo fncopnerr
  282.     'Open the files
  283.     iFNum = FreeFile
  284.     Open sInName For Input As #iFNum
  285.     
  286.     iFOut = FreeFile
  287.     Open szFinalDir + "\moo.Tmp" For Output As #iFOut
  288.     
  289.     Do Until EOF(iFNum)
  290.         Line Input #iFNum, sTemp
  291.         sTemp = ReplaceData(sTemp, sInToken, sOutToken)
  292.         Print #iFOut, sTemp
  293.     Loop
  294.     Close #iFNum
  295.     Close #iFOut
  296.     
  297.     Kill sInName
  298.     Name szFinalDir + "\moo.tmp" As sInName
  299.     
  300.     
  301.     
  302.     ReplaceFile = True
  303.     Exit Function
  304.     
  305. fncopnerr:
  306.         MsgBox "Reap File Error - " & Error$ & ""
  307.         ' Resume
  308.         ReplaceFile = False
  309.         Exit Function
  310.  
  311. End Function
  312.  
  313.  
  314.  
  315. Function GenerateUUID() As String
  316.  
  317.     Shell "uuidgen -oMaggots.987"
  318.     Call Sleep(2000)
  319.     
  320.     Open "Maggots.987" For Input As 1
  321.     Line Input #1, GenerateUUID
  322.     Close #1
  323.     Kill "maggots.987"
  324.     
  325. End Function
  326.  
  327. Function GetPPGGuidString() As String
  328.  
  329.     Dim s As String
  330.     
  331.     s = "DEFINE_GUID(CLSID_" + szControlName + "GeneralPage, 0x" + Left(m_szGuidPropPage, 8) _
  332.         + ", 0x" + Mid(m_szGuidPropPage, 10, 4) + ", 0x" + Mid(m_szGuidPropPage, 15, 4) _
  333.         + ", 0x" + Mid(m_szGuidPropPage, 20, 2) + ", 0x" + Mid(m_szGuidPropPage, 22, 2) _
  334.         + ", 0x" + Mid(m_szGuidPropPage, 25, 2) + ", 0x" + Mid(m_szGuidPropPage, 27, 2) _
  335.         + ", 0x" + Mid(m_szGuidPropPage, 29, 2) + ", 0x" + Mid(m_szGuidPropPage, 31, 2) _
  336.         + ", 0x" + Mid(m_szGuidPropPage, 33, 2) + ", 0x" + Mid(m_szGuidPropPage, 35, 2) _
  337.         + ");"
  338.  
  339.     GetPPGGuidString = s
  340.  
  341. End Function
  342.  
  343. Private Sub lblmessage_Click()
  344.  
  345. End Sub
  346.  
  347.  
  348.